home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / MAKECH.ARJ / MAKECH.PRG < prev    next >
Text File  |  1992-04-23  |  5KB  |  177 lines
  1. ************************************************************************
  2. *
  3. *   For Clipper 5.0 developers the program builds and maintains an
  4. *   application specific header file containing definitions of each
  5. *   field in the .dbf files in the project directory.
  6. *
  7. *   This header file is used with the Scatter and Gather user functions
  8. *   distributed with this program.  See suporting documentation for
  9. *   more details.
  10. *
  11. *   Placed in public domain by the author: John Lucas
  12. *                                          John Lucas Systems Ltd.
  13. *                                          Toronto, CANADA
  14. *                                          CRS 'John Lucas'
  15. *                                          CIS 73700,1074
  16. *
  17. ************************************************************************
  18.  
  19. #Include "Inkey.ch"
  20.  
  21. #Define DirPr       Directories[1]
  22. #Define DirCh       Directories[2]
  23.  
  24. Function EasyCopy
  25.  
  26. Local DDREC, PrDbf, PrDbt
  27. Local I, FF
  28. Local Directories, Header, DbfNames
  29.  
  30. Directories := Setup()                  // Get directory paths
  31.  
  32. Header := OldHead(Directories)          // Get users part of header file
  33.  
  34. *
  35. *       Build array of all .dbf files in users project directory
  36. *
  37.  
  38. DbfNames := Directory (DirPr + "*.dbf")
  39.  
  40. @ 16,10 say "Processing file ==>"
  41.  
  42. aEval (DbfNames, {|x| Header := Header + BuildCh (DirPr + x[1])})
  43.  
  44. memowrit (DirCh, Header)                     // Write new header
  45.  
  46. @ 0,0 clear
  47. ? "EasyCopy completed"
  48. ?
  49.  
  50. return
  51.  
  52.  
  53. ************************************************************************
  54. *
  55. *       Build new defines for each field
  56. *
  57. ************************************************************************
  58.  
  59. Function BuildCh (FF)
  60.  
  61. Local mDefs := "", Hrt := chr(13) + chr(10)
  62.  
  63. FF := Substr(FF,1,at(".",FF)-1)
  64. @ 16,30 say padr(FF,30)
  65. use (FF) new alias Dbf
  66. FF := Substr(FF,rat("\",FF)+1,20)
  67.  
  68. mDefs := mDefs + Hrt + Hrt + Hrt + "// Field defines for " + FF + Hrt+ Hrt
  69.  
  70. for I = 1 to fcount()
  71.     mDefs := mDefs + "#Define m" + padr(FieldName(I),25) +;
  72.                      "a" + FF + " [" + str(I,2) + "]" + ;
  73.                      Hrt
  74. next I
  75.  
  76. close Dbf
  77.  
  78. return mDefs + Hrt
  79.            
  80.       
  81.  
  82.  
  83. ****************************************************************************
  84. *
  85. *       Get directory paths and other setup stuff
  86. *
  87. ****************************************************************************
  88.  
  89. Function Setup
  90.  
  91. setkey (K_F10, {|| __Keyboard(chr(K_Ctrl_W))})
  92.            
  93. if File ("CH.mem")
  94.     Restore from CH additive
  95. else
  96.     Private Dir_Pr := space(40)
  97.     Private Dir_Ch := space(40)
  98. endif
  99.  
  100. Dir_Pr := padr(Dir_Pr,40)
  101. Dir_Ch := padr(Dir_Ch,40)
  102.  
  103. @  0, 0  clear
  104. @  1,  8 say "<< MakeCh >>"
  105. @  1, 22 to 1,77 double
  106.  
  107. @  3, 8, 11,77 box "████████"
  108. setcolor ("N/W")
  109. @  3, 9 say "Enter directory paths"
  110. @ 11, 9 say "F10 to accept"
  111. @ 11,66 say "Esc to quit"
  112. set color to
  113. do while lastkey() <> K_Ctrl_W
  114.     @  6,10 say "      Project directory:" get Dir_Pr
  115.     @  8,10 say "Header directory & name:" get Dir_Ch
  116.     ReadIt
  117.     if Escaped; quit; endif
  118. enddo
  119.  
  120. set cursor off
  121.  
  122. Dir_Pr := trim(Dir_Pr)
  123. Dir_Ch := trim(Dir_Ch)
  124.  
  125. if right(Dir_Pr,1) <> "\";               Dir_Pr := Dir_Pr + "\";       endif
  126. if len(Dir_Ch) > 0 .and. upper(right(Dir_Ch,3)) <> ".CH"
  127.     Dir_Ch := Dir_Ch + ".ch"
  128. endif
  129.  
  130. save all like Dir_* to CH
  131.  
  132. return {Dir_Pr, Dir_Ch}
  133.  
  134.  
  135.  
  136. ************************************************************************
  137. *
  138. *       Get previous header without our definitions
  139. *
  140. ************************************************************************
  141.  
  142. Function OldHead (Directories)
  143.  
  144. Local Head := "", I, Hrt := chr(13) + chr(10)
  145.  
  146. if File(DirCh)
  147.     Head := memoread(DirCh)                     // Get existing header file
  148. endif
  149.  
  150. I := at("// Common data base defines", Head)
  151. if I > 0
  152.     Head = Left(Head,I-1)                       // Drop old versions
  153. endif
  154.  
  155. Head := Head + "// Common data base defines"    // New separator
  156. Head := Head + Hrt
  157.  
  158. *
  159. *       Copy commands for Scatter and Gather
  160. *
  161.  
  162. Head := Head + Hrt + ;
  163.     "#Command Scatter to <ar> [<new: new>]  => <ar> := Scatter(<.new.>)";
  164.     + Hrt
  165. Head := Head + ;
  166.     "#Command Scatter to <ar> from <alias> [<new: new>]  ;" + Hrt ;
  167.     + "     => <ar> := <alias> -> (Scatter(<.new.>))";
  168.     + Hrt
  169. Head := Head + ;
  170.     "#Command Gather from <ar>              => Gather(<ar>)";
  171.     + Hrt
  172. Head := Head + ;
  173.     "#Command Gather from <ar> to <alias>   => <alias> -> (Gather(<ar>))";
  174.     + Hrt
  175.  
  176. return Head
  177.